home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Moof
/
Goodies
/
HyperCard Goodies
/
HyperCard Dev. ToolKit
/
Video.Drivers
/
PioneerLVP4200.p
< prev
next >
Wrap
Text File
|
1987-08-17
|
9KB
|
342 lines
{$R-}
{$D+}
(*
Pioneer LVP 4200 -- a HyperCard user-defined command
to drive a laser disc player.
©Apple Computer, Inc. 1987
All Rights Reserved.
To compile and link this file using Macintosh Programmer's Workshop
(HyperXCmd.p and XCmdGlue.inc must be accessible).
pascal -w PioneerLVP4200.p
link -m ENTRYPOINT -o HyperCommands -rt XCMD=15 -sn Main=PioneerLVP4200 ∂
PioneerLVP4200.p.o "{MPW}"Libraries:interface.o
then use ResEdit to copy the resulting XCMD from HyperCommands
and paste it into the Home stack, or your own stack.
(XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000,
=15 PioneerLVP4200)
*)
{$S PioneerLVP4200 } { Segment name must be the same as the command name. }
UNIT DummyUnit;
INTERFACE
USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
IMPLEMENTATION
TYPE Str19 = String[19];
Str31 = String[31];
PROCEDURE PioneerLVP4200(paramPtr: XCmdPtr); FORWARD;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
{ entry point cannot have local procs, but forward routines can }
BEGIN
PioneerLVP4200(paramPtr);
END;
PROCEDURE PioneerLVP4200(paramPtr: XCmdPtr);
VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
tempStr: Str255;
refNum: INTEGER;
err: INTEGER;
params: ARRAY[1..32] OF Str19;
{$I XCmdGlue.inc }
PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
BEGIN
paramPtr^.returnValue := PasToZero(errMsg);
EXIT(PioneerLVP4200);
END;
PROCEDURE OpenSerial;
VAR handShake: SerShk;
baudRate: INTEGER;
BEGIN
baudRate := 4800;
{ for now, use modem port so we don't mess with AppleTalk }
err := FSOpen('.AOUT',0,refNum);
IF err = 0 THEN
BEGIN
WITH handShake DO
BEGIN
fXon := 1;
fCTS := 1;
xon := CHR(17);
xoff := CHR(19);
errs := 0;
evts := 0;
fInx := 0;
END;
err := SerHShake(refNum,handShake);
IF err = 0 THEN
err := Control(refNum,13,@baudRate);
END;
END;
PROCEDURE CloseSerial;
BEGIN
err := FSClose(refNum);
END;
PROCEDURE SendCommand(cmd: Str255);
VAR count: LongInt;
{ all commands must have an extra char at end, which we smash with CR }
BEGIN
count := Length(cmd);
cmd[count] := CHAR(13); { carriage return }
err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
END;
FUNCTION Concat(str1, str2, str3: Str255): Str255;
VAR result: Str255;
resultLen: INTEGER;
charNum: INTEGER;
BEGIN
result := '';
resultLen := 0;
FOR charNum := 1 TO Length(str1) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str1[charNum];
END;
FOR charNum := 1 TO Length(str2) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str2[charNum];
END;
FOR charNum := 1 TO Length(str3) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str3[charNum];
END;
result[0] := CHR(resultLen);
Concat := result;
END;
PROCEDURE GetMessage;
VAR paramNum, charNum: INTEGER;
msgChar: CHAR;
BEGIN
{ convert params to pascal strings }
FOR paramNum := 1 TO paramPtr^.paramCount DO
BEGIN
tempStr := params[paramNum];
ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
{ force all chars to lower case }
FOR charNum := 1 TO Length(tempStr) DO
BEGIN
msgChar := tempStr[charNum];
IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
END;
params[paramNum] := tempStr;
END;
END;
FUNCTION Contains(target: Str255): BOOLEAN;
VAR offset: INTEGER;
FUNCTION Match(which: INTEGER): BOOLEAN;
VAR index: INTEGER;
BEGIN
Match := TRUE;
FOR index := 1 TO Length(target) DO
IF index > Length(params[which]) THEN
BEGIN
Match := FALSE; { ran off the end }
EXIT(Match);
END
ELSE IF target[index] <> params[which][index] THEN
BEGIN
Match := FALSE; { hit a wrong char }
EXIT(Match);
END;
END;
BEGIN
Contains := FALSE;
FOR offset := 1 TO paramPtr^.paramCount DO
IF Match(offset) THEN
BEGIN
Contains := TRUE;
EXIT(Contains);
END;
END;
FUNCTION GetDigit(digit: CHAR): Str255;
BEGIN
CASE digit OF
{ doing a type conversion }
'0': GetDigit := '0';
'1': GetDigit := '1';
'2': GetDigit := '2';
'3': GetDigit := '3';
'4': GetDigit := '4';
'5': GetDigit := '5';
'6': GetDigit := '6';
'7': GetDigit := '7';
'8': GetDigit := '8';
'9': GetDigit := '9';
END;
END;
FUNCTION GetInteger: Str255;
{ get an integer in Pioneer format }
VAR which, digitLoc, charVal: INTEGER;
intStr: Str255;
BEGIN
intStr := '';
FOR which := 1 TO paramPtr^.paramCount DO
BEGIN
charVal := ORD(params[which][1]);
IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
BEGIN
FOR digitLoc := 1 TO Length(params[which]) DO
intStr := Concat(intStr, GetDigit(params[which][digitLoc]),'');
GetInteger := intStr;
exit(GetInteger);
END;
END;
GetInteger := intStr; { just in case }
END;
BEGIN
OpenSerial;
IF err <> 0 THEN
BEGIN
SysBeep(1);
Fail('Could not open serial port');
END;
GetMessage;
{ set flags }
reverseFlag := Contains('rev');
offFlag := Contains('off');
tillFlag := Contains('till');
IF Contains('stop') THEN SendCommand('ST^')
ELSE IF Contains('eject') THEN SendCommand('RJ OP^')
ELSE IF Contains('search') THEN SendCommand(Concat(GetInteger, 'SE', '^'))
ELSE IF Contains('step') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('SF^') {step fwd}
ELSE SendCommand('SR^') {step rev}
END
ELSE IF Contains('play') THEN
BEGIN
IF NOT tillFlag THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('PL^') {play fwd}
ELSE SendCommand('60 SP MR^'); {play rev}
END
ELSE SendCommand(Concat('FR', GetInteger, 'PL^')) {play till}
END
ELSE IF Contains('slower') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('15 SP FR ', GetInteger, ' MR^'))
ELSE SendCommand(Concat('15 SP FR ', GetInteger, ' MF^'));
END
ELSE IF reverseFlag THEN SendCommand('15 SP MR^')
ELSE SendCommand('15 SP MF^')
END
ELSE IF Contains('slowest') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('10 SP FR ', GetInteger, ' MR^'))
ELSE SendCommand(Concat('10 SP FR ', GetInteger, ' MF^'));
END
ELSE IF reverseFlag THEN SendCommand('10 SP MR^')
ELSE SendCommand('10 SP MF^')
END
ELSE IF Contains('slow') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('30 SP FR ', GetInteger, ' MR^'))
ELSE SendCommand(Concat('30 SP FR ', GetInteger, ' MF^'));
END
ELSE IF reverseFlag THEN SendCommand('30 SP MR^')
ELSE SendCommand('30 SP MF^')
END
ELSE IF Contains('faster') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('240 SP FR ', GetInteger, ' MR^'))
ELSE SendCommand(Concat('240 SP FR ', GetInteger, ' MF^'));
END
ELSE IF reverseFlag THEN SendCommand('240 SP MR^')
ELSE SendCommand('240 SP MF^')
END
ELSE IF Contains('fast') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('180 SP FR ', GetInteger, ' MR^'))
ELSE SendCommand(Concat('180 SP FR ', GetInteger, ' MF^'));
END
ELSE IF reverseFlag THEN SendCommand('180 SP MR^')
ELSE SendCommand('180 SP MF^')
END
ELSE IF Contains('scan') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('NF^') {scan fwd}
ELSE SendCommand('NR^') {scan rev}
END
ELSE IF Contains('picture') THEN
BEGIN
IF NOT offFlag THEN SendCommand('1VD^') {picture on}
ELSE SendCommand('0VD^') {picture off}
END
ELSE IF Contains('frame') THEN
BEGIN
IF NOT offFlag THEN SendCommand('1DS^') {frame on}
ELSE SendCommand('0DS^') {frame off}
END
ELSE IF Contains('sound') THEN
BEGIN
IF Contains('1') THEN
IF NOT offFlag THEN SendCommand('1AD^') {sound 1 on}
ELSE SendCommand('0AD^') {sound 1 off}
ELSE IF Contains('2') THEN
IF NOT offFlag THEN SendCommand('2AD^') {sound 2 on}
ELSE SendCommand('0AD^') {sound 2 off}
ELSE
IF NOT offFlag THEN SendCommand('3AD^') {sound stereo on}
ELSE SendCommand('0AD^'); {sound stereo off}
END
ELSE IF Contains('init') THEN SendCommand('SA^')
ELSE
BEGIN
CloseSerial;
SysBeep(1);
Fail('Unknown video command');
END;
CloseSerial;
END;
END.